home *** CD-ROM | disk | FTP | other *** search
/ Sound Fx / Sound Fx.iso / Software / UNZIPED / DWSTK / PLAYDWM.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-10-10  |  6.3 KB  |  219 lines
  1. '******************************************************************************
  2. 'File:      playdwm.bas
  3. 'Version:   2.22
  4. 'Tab stops: every 2 columns
  5. 'Project:   DWD Player
  6. 'Copyright: 1994-1995 DiamondWare, Ltd.  All rights reserved.
  7. 'Written:   Erik Lorenzen & Don Lemmons
  8. 'Purpose:   Contains simple example code to show how to load/play a .DWM file
  9. 'History:   94/10/21 KW Started playdwm.c
  10. '           94/11/12 DL Translated to BASIC
  11. '           95/01/12 EL Cleaned up & Finalized
  12. '           95/03/22 EL Finalized for 1.01
  13. '           95/04/11 EL Finalized for 1.02
  14. '           95/06/06 EL Finalized for 1.03, no changes
  15. '           95/06/06 EL Finalized for 2.00, no changes
  16. '           95/10/07 EL Finalized for 2.10, no changes
  17. '           95/10/18 EL Finalized for 2.20, changed vol's to 95%
  18. '           95/12/07 EL Finalized for 2.21, no changes
  19. '           96/10/10 EL Finalized for 2.22, no changes
  20. '
  21. 'Notes
  22. '-----
  23. 'This code isn't really robust when it comes to standard error checking
  24. 'and particularly recovery, software engineering technique, etc.  A buffer
  25. 'is statically allocated.  A better technique would be to use fstat() or stat()
  26. 'to determine the file's size then malloc(size).    The STK will handle songs
  27. 'larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  28. 'such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  29. 'exitting and cleanup is not handled robustly in this code.  The code below can
  30. 'only be validated by extremely careful scrutiny to make sure each case is
  31. 'handled properly.  A better method would the use of C's atexit function.
  32. '
  33. 'But all such code would make this example file less clear; its purpose was
  34. 'to illustrate how to call the STK, not how to write QA-proof software.
  35. '******************************************************************************/
  36.  
  37.  
  38.  
  39. '$INCLUDE: 'dws.bi'
  40. '$INCLUDE: 'dwt.bi'
  41. '$INCLUDE: 'err.bi'
  42.  
  43.  
  44.  
  45. TYPE BUFFTYP
  46.     buf AS STRING * 32767
  47. END TYPE
  48.  
  49.  
  50.  
  51. 'DECLARE VARIABLES
  52.     COMMON SHARED dov     AS dwsDETECTOVERRIDES
  53.     COMMON SHARED dres    AS dwsDETECTRESULTS
  54.     COMMON SHARED ideal AS dwsIDEAL
  55.     COMMON SHARED mplay AS dwsMPLAY
  56.  
  57.  
  58.  
  59. DIM SHARED buffer(0) AS BUFFTYP 'set aside string area for song to load into
  60.                                                                 'by doing it this way we give QBasic the
  61.                                                                 'opportunity to place the song into far mem
  62. 'START OF MAIN
  63.  
  64.     PRINT
  65.     PRINT "PLAYDWM 2.22 is Copyright 1994-95, DiamondWare, Ltd."
  66.     PRINT "All rights reserved."
  67.     PRINT : PRINT : PRINT
  68.  
  69.     musvol%         = 255
  70.  
  71.     filename$ = LTRIM$(RTRIM$(COMMAND$))
  72.     IF filename$ = "" THEN
  73.         PRINT "Usage PLAYDWD <dwd-file>"
  74.         GOTO ProgramExit
  75.     END IF
  76.  
  77.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  78.     filelen = LOF(1)
  79.     CLOSE #1
  80.  
  81.     IF filelen = 0 THEN
  82.         PRINT "File Not Found"
  83.         GOTO ProgramExit
  84.     END IF
  85.  
  86.     IF filelen > 32767 THEN
  87.         PRINT "File Too Big"
  88.         GOTO ProgramExit
  89.     END IF
  90.  
  91.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  92.     GET #1, 1, buffer(0).buf
  93.     CLOSE #1
  94.  
  95.     'We need to set every field to -1 in dwsDETECTOVERRIDES struct; this
  96.     'tells the STK to autodetect everything.  Any other value
  97.     'overrides the autodetect routine, and will be accepted on
  98.     'faith, though the STK will verify it if possible.
  99.  
  100.     dov.baseport = -1
  101.     dov.digdma     = -1
  102.     dov.digirq     = -1
  103.  
  104.     IF DWSDetectHardWare(dov, dres) = 0 THEN
  105.         errDisplay
  106.         GOTO ProgramExit
  107.     END IF
  108.  
  109.     IF (dres.capability AND dwscapabilityFM) <> dwscapabilityFM THEN
  110.         PRINT"FM support not found"
  111.         GOTO ProgramExit
  112.     END IF
  113.  
  114.     'The "ideal" struct tells the STK how you'd like it to initialize the
  115.     'sound hardware.      In all cases, if the hardware won't support your
  116.     'request, the STK will go as close as possible.  For example, not all
  117.     'sound boards will support al sampling rates (some only support 5 or
  118.     '6 discrete rates).
  119.  
  120.     ideal.musictyp     = 1                    '0=No music, 1=OPL2
  121.     ideal.digtyp         = 0                    '0=No Dig, 8=8bit, 16=16bit
  122.     ideal.digrate      = 0                    'sampling rate, in Hz
  123.     ideal.dignvoices = 0                    'number of voicws.bies (up to 16)
  124.     ideal.dignchan     = 0                    '1=mono, 2=stereo
  125.  
  126.     IF dwsInit(dres, ideal) = 0 THEN
  127.         errDisplay
  128.         GOTO ProgramKill
  129.     END IF
  130.  
  131.     'Set music vol to about 95% of max
  132.     musvol% = 242
  133.     IF dwsXMusic(musvol%) = 0 THEN
  134.         errDisplay
  135.     END IF
  136.  
  137.     '72.8Hz is a decent compromise.  It will work in a Windows DOS box
  138.     'without any problems, and yet it allows music to sound pretty good.
  139.     'In my opinion, there's no reason to go lower than 72.8 (unless you
  140.     'don't want the hardware timer reprogrammed)--music sounds kinda chunky
  141.     'at lower rates.  You can go to 145.6 Hz, and get smoother (very
  142.     'subtly) sounding music, at the cost that it will NOT run at the correct
  143.     '(or constant) speed in a Windows DOS box.
  144.  
  145.     dwtInit(dwt728HZ)
  146.  
  147.     soundseg% = VARSEG(buffer(0).buf)
  148.     soundoff% = VARPTR(buffer(0).buf)
  149.     pointer&    = soundseg% * 256 ^ 2 + soundoff%  'make pointer
  150.  
  151.     mplay.track = pointer&
  152.     mplay.count = 1                  '0=infinite loop, 1-N num times to play sound
  153.  
  154.     IF dwsMPlay(mplay) = 0 THEN
  155.         errDisplay
  156.         GOTO ProgramKill
  157.     END IF
  158.  
  159.     'We're playing.  Let's exit when the song is over, and allow the user
  160.     'to fiddle with the volume level (mixer) in the meantime
  161.  
  162.     PRINT"Press + or - to change playback volume"
  163.  
  164.     result% = dwsMSONGSTATUSPLAYING
  165.     DO UNTIL (result%  AND dwsMSONGSTATUSPLAYING) <> dwsMSONGSTATUSPLAYING
  166.         inpt$ = INKEY$
  167.  
  168.         IF inpt$ = "+" THEN
  169.             musvol% = musvol% + 1
  170.  
  171.             PRINT"Music Volume is ";musvol%
  172.  
  173.             IF dwsXMusic(musvol%) = 0 THEN
  174.                 errDisplay
  175.             END IF
  176.         END IF
  177.  
  178.         IF inpt$ = "-" THEN
  179.             musvol% = musvol% - 1
  180.  
  181.             PRINT"Music Volume is ";musvol%
  182.  
  183.             IF dwsXMusic(musvol%) = 0 THEN
  184.                 errDisplay
  185.             END IF
  186.         END IF
  187.  
  188.         IF inpt$ = "q" OR inpt$ = "q" OR inpt$ = chr$(27) THEN
  189.             GOTO ProgramKill
  190.         END IF
  191.  
  192.         IF dwsMSongStatus(result%) = 0 THEN
  193.             errDisplay
  194.             GOTO ProgramKill
  195.         END IF
  196.     LOOP
  197.  
  198.     ProgramKill:
  199.  
  200.     'If dwt is not inited calling dwt_Kill will have no effect
  201.     dwtKill
  202.  
  203.     IF dwsKill = 0 THEN
  204.         errnum = dwsErrNo
  205.         errDisplay
  206.  
  207.         'If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  208.         'or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  209.         'must remove his tsr, and dws_Kill must be called again.  If it's
  210.         'dws_NOTINITTED, there's nothing to worry about at this point.
  211.         IF errnum = dwsKillCANTUNHOOKISR THEN
  212.             GOTO ProgramKill
  213.         END IF
  214.     END IF
  215.  
  216.     ProgramExit:
  217.  
  218. END
  219.